home *** CD-ROM | disk | FTP | other *** search
/ Aminet 32 / Aminet 32 (1999)(Schatztruhe)[!][Aug 1999].iso / Aminet / dev / misc / numconv.lha / numconv.e < prev    next >
Text File  |  1999-05-26  |  7KB  |  248 lines
  1. /* E Source generated by SRCGEN v0.4 */
  2.  
  3. OPT OSVERSION=37,REG=5
  4.  
  5. MODULE 'gadtools',
  6.        'libraries/gadtools',
  7.        'intuition/intuition',
  8.        'intuition/screens',
  9.        'intuition/gadgetclass',
  10.        'intuition/iobsolete',
  11.        'utility/tagitem',
  12.        'devices/inputevent',
  13.        'graphics/text',
  14.        'tools/detatch'
  15.  
  16. ENUM ERROR_NONE,
  17.      ERROR_CONTEXT,
  18.      ERROR_GADGET,
  19.      ERROR_WB,
  20.      ERROR_VISUAL,
  21.      ERROR_GT,
  22.      ERROR_WINDOW,
  23.      ERROR_MENUS
  24.  
  25. ENUM G_SRC,G_DST,G_STR,G_TXT,G_CB
  26. ENUM DECI,HEX,BIN,ASCII,FLOAT
  27.  
  28. DEF infos:PTR TO gadget,
  29.     wnd:PTR TO window,
  30.     glist,
  31.     scr:PTR TO screen,
  32.     visual=NIL,
  33.     tattr:PTR TO textattr,
  34.     id
  35. DEF gsrc,gdst,gs,gt,gcb
  36. DEF src,dst,str:PTR TO CHAR,txt[36]:STRING,num,error=FALSE
  37.  
  38. PROC setupscreen()
  39.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ERROR_GT
  40.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ERROR_WB
  41.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ERROR_VISUAL
  42.   tattr:=['topaz.font',8,0,0]:textattr
  43. ENDPROC
  44.  
  45. PROC closedownscreen()
  46.   IF visual THEN FreeVisualInfo(visual)
  47.   IF scr THEN UnlockPubScreen(NIL,scr)
  48.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  49. ENDPROC
  50.  
  51. PROC openwindow()
  52.   DEF g:PTR TO gadget
  53.   IF (g:=CreateContext({glist}))=NIL THEN RETURN ERROR_CONTEXT
  54.   IF (gsrc:=CreateGadgetA(CYCLE_KIND,g,
  55.     [4,4,85,21,NIL,tattr,G_SRC,$0,visual,0]:newgadget,
  56.     [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT',0],
  57.      GTCY_ACTIVE,DECI,
  58.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  59.   IF (gdst:=CreateGadgetA(CYCLE_KIND,gsrc,
  60.     [4,28,85,21,NIL,tattr,G_DST,$0,visual,0]:newgadget,
  61.     [GTCY_LABELS,['DEC','HEX','BIN','ASCII','FLOAT',0],
  62.      GTCY_ACTIVE,HEX,
  63.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  64.   IF (gs:=CreateGadgetA(STRING_KIND,gdst,
  65.     [92,4,245,21,NIL,tattr,G_STR,$0,visual,0]:newgadget,
  66.     [GTST_MAXCHARS,34,
  67.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  68.   IF (gt:=CreateGadgetA(TEXT_KIND,gs,
  69.     [92,28,269,21,NIL,tattr,G_TXT,$0,visual,0]:newgadget,
  70.     [GTTX_BORDER,TRUE,
  71.      TAG_END]))=NIL THEN RETURN ERROR_GADGET
  72.   IF (gcb:=CreateGadgetA(BUTTON_KIND,gt,
  73.     [340,4,21,21,'CB',tattr,G_CB,$0,visual,0]:newgadget,NIL))=NIL THEN RETURN ERROR_GADGET
  74.   IF (wnd:=OpenWindowTagList(NIL,
  75.     [WA_LEFT,0,
  76.      WA_TOP,scr.barheight+1,
  77.      WA_INNERWIDTH,364,
  78.      WA_INNERHEIGHT,52,
  79.      WA_IDCMP,IDCMP_GADGETUP OR IDCMP_GADGETDOWN OR IDCMP_CLOSEWINDOW OR IDCMP_ACTIVEWINDOW OR IDCMP_CHANGEWINDOW,
  80.      WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_GIMMEZEROZERO OR WFLG_ACTIVATE OR WFLG_RMBTRAP,
  81.      WA_TITLE,'NumConv v1.1 by Martin Kuchinka',
  82.      WA_SCREENTITLE,'NoTek 99',
  83.      WA_CUSTOMSCREEN,scr,
  84.      WA_AUTOADJUST,TRUE,
  85.      WA_GADGETS,glist,
  86.      TAG_END]))=NIL THEN RETURN ERROR_WINDOW
  87.   Gt_RefreshWindow(wnd,NIL)
  88. ENDPROC
  89.  
  90. PROC closewindow()
  91.   IF wnd THEN CloseWindow(wnd)
  92.   IF glist THEN FreeGadgets(glist)
  93. ENDPROC
  94.  
  95. PROC process(win:PTR TO window)
  96.   DEF type=0
  97.   ActivateGadget(gs,win,NIL)
  98.   REPEAT
  99.     type:=wait4message(win)
  100.     SELECT type
  101.     CASE IDCMP_CLOSEWINDOW;    RETURN
  102.     CASE IDCMP_GADGETUP
  103.      go:
  104.       Gt_GetGadgetAttrsA(gsrc,win,NIL,[GTCY_ACTIVE,{src},TAG_END])
  105.       Gt_GetGadgetAttrsA(gdst,win,NIL,[GTCY_ACTIVE,{dst},TAG_END])
  106.       Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
  107.       IF id=G_CB
  108.         Gt_SetGadgetAttrsA(gs,win,NIL,[GTST_STRING,txt,TAG_END])
  109.         Gt_GetGadgetAttrsA(gs,win,NIL,[GTST_STRING,{str},TAG_END])
  110.         ENDIF
  111.       SELECT dst
  112.       CASE DECI
  113.         SELECT src
  114.         CASE DECI; StrCopy(txt,str)
  115.         CASE HEX;  StringF(txt,'$\s',str); num:=Val(txt); StringF(txt,'\d',num)
  116.         CASE BIN;  StringF(txt,'\d',bin2num(str))
  117.         CASE ASCII;StringF(txt,'\d',ascii2num(str))
  118.         CASE FLOAT;StringF(txt,'\d',RealVal(str))
  119.         ENDSELECT
  120.       CASE HEX
  121.         SELECT src
  122.         CASE DECI; StringF(txt,'\h',Val(str))
  123.         CASE HEX;  StrCopy(txt,str)
  124.         CASE BIN;  StringF(txt,'\h',bin2num(str))
  125.         CASE ASCII;StringF(txt,'\h',ascii2num(str))
  126.         CASE FLOAT;StringF(txt,'\h',RealVal(str))
  127.         ENDSELECT
  128.       CASE BIN
  129.         SELECT src
  130.         CASE DECI; num2bin(txt,Val(str))
  131.         CASE HEX;  StringF(txt,'$\s',str); num2bin(txt,Val(txt))
  132.         CASE BIN;  num2bin(txt,bin2num(str))
  133.         CASE ASCII;num2bin(txt,ascii2num(str))
  134.         CASE FLOAT;num2bin(txt,RealVal(str))
  135.         ENDSELECT
  136.       CASE ASCII
  137.         SELECT src
  138.         CASE DECI; num2ascii(txt,Val(str))
  139.         CASE HEX;  StringF(txt,'$\s',str); num2ascii(txt,Val(txt))
  140.         CASE BIN;  num2ascii(txt,bin2num(str))
  141.         CASE ASCII;StrCopy(txt,str)
  142.         CASE FLOAT;num2ascii(txt,RealVal(str))
  143.         ENDSELECT
  144.       CASE FLOAT
  145.         SELECT src
  146.         CASE DECI; RealF(txt,Val(str),6)
  147.         CASE HEX;  StringF(txt,'$\s',str); RealF(txt,Val(str),6)
  148.         CASE BIN;  RealF(txt,bin2num(str),6)
  149.         CASE ASCII;RealF(txt,ascii2num(str),6)
  150.         CASE FLOAT;RealF(txt,RealVal(str),6)
  151.         ENDSELECT
  152.       ENDSELECT
  153.       IF error=FALSE THEN Gt_SetGadgetAttrsA(gt,win,NIL,[GTTX_TEXT,txt,TAG_END])
  154.       error:=FALSE
  155.       ActivateGadget(gs,win,NIL)
  156.     DEFAULT;        JUMP go
  157.     ENDSELECT
  158.   UNTIL type=IDCMP_CLOSEWINDOW
  159. ENDPROC
  160.  
  161. PROC wait4message(win:PTR TO window)
  162.   DEF mes:PTR TO intuimessage,type
  163.   REPEAT
  164.     type:=0
  165.     IF mes:=Gt_GetIMsg(win.userport)
  166.       type:=mes.class
  167.       IF type=IDCMP_GADGETUP
  168.         infos:=mes.iaddress
  169.         id:=infos.gadgetid
  170.       ENDIF
  171.       Gt_ReplyIMsg(mes)
  172.     ELSE
  173.       WaitPort(win.userport)
  174.     ENDIF
  175.   UNTIL type
  176. ENDPROC type
  177.  
  178. PROC reporterr(er)
  179.   DEF erlist:PTR TO LONG
  180.   IF er
  181.     erlist:=['get context',
  182.              'create gadget',
  183.              'lock wb',
  184.              'get visual infos',
  185.              'open "gadtools.library" v37+',
  186.              'open window',
  187.              'create menus']
  188.     EasyRequestArgs(0,[20,0,0,'Could not \s!','OK'],0,[erlist[er-1]])
  189.   ENDIF
  190. ENDPROC er
  191.  
  192. PROC main() HANDLE
  193.   detatch('NumConv')
  194.   IF reporterr(setupscreen())=0
  195.     reporterr(openwindow())
  196.     process(wnd)
  197.     closewindow()
  198.     IF CtrlC() THEN Raise(ERROR_NONE)
  199.   ENDIF
  200.   Raise(ERROR_NONE)
  201. EXCEPT
  202.   closedownscreen()
  203. ENDPROC
  204.  
  205. PROC bin2num(str:PTR TO CHAR)
  206.     DEF num=0,n=0
  207.     WHILE str[n]="0" DO n++
  208.     WHILE str[n]
  209.         IF str[n]="0";            num:=Shl(num,1)
  210.         ELSEIF str[n]="1";    num:=Shl(num,1) OR 1
  211.         ELSE
  212.             Gt_SetGadgetAttrsA(gt,wnd,NIL,[GTTX_TEXT,'Illegal Character',TAG_END])
  213.             error:=TRUE
  214.         ENDIF
  215.         n++
  216.     ENDWHILE
  217. ENDPROC num
  218.  
  219. PROC ascii2num(str:PTR TO CHAR)
  220.     DEF num,s=0
  221.     num:=^str
  222.     IF (num AND $00ff0000)=0 THEN s:=3 ELSE IF (num AND $0000ff00)=0 THEN s:=2 ELSE IF (num AND $000000ff)=0 THEN s:=1
  223.     num:=Shr(num,s*8)
  224. ENDPROC num
  225.  
  226. PROC num2bin(txt:PTR TO CHAR,num)
  227.     DEF n=31,i=0
  228.     WHILE n+1
  229.         txt[i]:=IF num AND Shl(1,n) THEN "1" ELSE "0"
  230.         n--
  231.         i++
  232.     ENDWHILE
  233.     txt[i]:=0
  234. ENDPROC
  235.  
  236. PROC num2ascii(txt:PTR TO CHAR,num)
  237.     DEF n
  238.     IF num<=$ff;    num:=Shl(num,24)
  239.     ELSEIF num<=$ffff;    num:=Shl(num,16)
  240.     ELSEIF num<=$ffffff;    num:=Shl(num,8)
  241.     ENDIF
  242.     ^txt:=num
  243.     txt[4]:=0
  244.     FOR n:=0 TO 3
  245.         IF ((txt[n]>="\0") AND (txt[n]<" ")) OR ((txt[n]>=128) AND (txt[n]<160)) THEN txt[n]:="."
  246.     ENDFOR
  247. ENDPROC
  248.